home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
windows
/
wntdy202.zip
/
MAINFORM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-16
|
10KB
|
346 lines
unit MainForm;
{
WinTidy - program to clear out unwanted files
Revision history:
1995 Apr 23 1.0.0 First version derived from DOS-based TIDY
and WIN_TIDY programs. Takes command line
parameter for root directory.
1995 Apr 25 1.0.2 Use proper Screen.Cursor for hourglass
Make caption reflect current scan location
1995 Nov 25 1.0.4 Add .RWS as unwanted file, Borland Resource Workshop binary
Replace two list boxes by one with size integral
Order files by size
Add Select All button
1995 Dec 02 1.0.6 Add .WBK as unwanted file, WinWord 7 backup
1996 Jan 06 1.0.8 Only enable Delete button when relevant
Make Find button have a Cancel function
Use Delphi's own LowerCase function
1996 Mar 30 2.0.0 Delphi 2.0 32-bit version
Allow limited form re-sizing
Add .APS as unwanted file, Vis C++ binary saved resources
Remove hour-glass cursor
Add indication of bytes found for deleting
Note that .MOZ and other cache files might be candidates
1996 Apr 16 2.0.2 Add severity button, find .FTS, .GID
Add .DMP files to normal list
Add status bar
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl, ExtCtrls, Buttons, ComCtrls;
type
Tfiles_to_find = (normal, extra);
type
TForm1 = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
DirectoryListBox1: TDirectoryListBox;
DriveComboBox1: TDriveComboBox;
btnFind: TButton;
ListBox1: TListBox;
btnSelectAll: TButton;
btnDelete: TButton;
btnExit: TButton;
Label1: TLabel;
Label2: TLabel;
lblSize: TLabel;
grpSeverity: TRadioGroup;
btnNormal: TRadioButton;
btnExtra: TRadioButton;
StatusBar1: TStatusBar;
procedure btnExitClick(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSelectAllClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure btnFindClick(Sender: TObject);
procedure Panel1Resize(Sender: TObject);
procedure Panel2Resize(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnNormalClick(Sender: TObject);
procedure btnExtraClick(Sender: TObject);
private
{ Private declarations }
scanning: boolean;
stop_requested: boolean;
files_to_find: Tfiles_to_find;
files_found: integer;
KB_found: integer;
suggested_min_x: integer;
suggested_min_y: integer;
procedure scan_tree (root: string);
protected
procedure GetMinMaxInfo (var info: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{$R version.res} // 32-bit resource file
const
num_normal_names = 16;
normal_names: array [1..num_normal_names] of string =
('*.tmp',
'~*.*',
'*.~*',
'*.?~?',
'*.aps',
'*.bak',
'*.bk?',
'*.bsc',
'*.dmp',
'*.dsm',
'*.ilk',
'*.pch',
'*.rws',
'*.sbr',
'backup*.wbk',
'*.$$$');
const
num_extra_names = 2;
extra_names: array [1..num_extra_names] of string =
('*.fts',
'*.gid');
procedure TForm1.FormCreate(Sender: TObject);
var
params: string;
begin
scanning := False;
btnDelete.Enabled := False;
btnSelectAll.Enabled := False;
stop_requested := False;
files_to_find := normal;
if ParamCount > 0 then
begin
params := ParamStr (1);
DriveComboBox1.Drive := params [1];
DirectoryListBox1.Directory := params;
end;
suggested_min_x := Width;
suggested_min_y := Height;
end;
procedure TForm1.btnExitClick(Sender: TObject);
begin
stop_requested := True; // to stop the scanning loop
Close;
end;
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
Form1.Caption := 'WinTidy - ' + LowerCase (DirectoryListBox1.Directory);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.Caption := 'WinTidy - ' + DirectoryListBox1.Directory;
end;
procedure TForm1.btnSelectAllClick(Sender: TObject);
var
item: integer;
begin
for item := 0 to ListBox1.Items.Count-1 do
ListBox1.Selected [item] := True;
btnDelete.Enabled := ListBox1.SelCount <> 0;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
btnDelete.Enabled := ListBox1.SelCount <> 0;
end;
procedure TForm1.btnFindClick(Sender: TObject);
begin
if scanning
then stop_requested := True
else
begin
btnFind.Caption := 'Stop';
btnDelete.Enabled := False;
btnSelectAll.Enabled := False;
lblSize.Caption := '';
Label1.Caption := '';
ListBox1.Clear;
scanning := True;
stop_requested := False;
DriveComboBox1.Enabled := False;
DirectoryListBox1.Enabled := False;
files_found := 0;
KB_found := 0;
try
scan_tree (DirectoryListBox1.Directory);
finally
end;
scanning := False;
DriveComboBox1.Enabled := True;
DirectoryListBox1.Enabled := True;
btnFind.Caption := 'Find';
btnSelectAll.Enabled := True;
if files_found <> 0
then
begin
Label1.Caption := 'Candidates for deleting ....';
StatusBar1.SimpleText := '';
btnSelectAll.Enabled := True;
end
else
begin
Label1.Caption := '';
StatusBar1.SimpleText := 'No files found';
btnSelectAll.Enabled := False;
end;
end;
end;
procedure TForm1.scan_tree (root: string);
var
test_name: string;
full_name: string;
s: TSearchRec;
wanted: integer;
num_to_check: integer;
KB: integer;
begin
if stop_requested then Exit;
root := LowerCase (root);
StatusBar1.SimpleText := 'Searching ' + root + '...';
if root [Length (root)] <> '\' then root := root + '\';
case files_to_find of
normal: num_to_check := num_normal_names;
extra: num_to_check := num_extra_names;
end;
for wanted := 1 to num_to_check do
begin
Application.ProcessMessages;
case files_to_find of
normal: test_name := root + normal_names [wanted];
extra: test_name := root + extra_names [wanted];
end;
if FindFirst (test_name, faAnyFile, s) = 0 then
repeat
if stop_requested then Exit;
with s do
begin
Name := LowerCase (Name);
if (Attr <> faDirectory) then
begin
full_name := root + Name;
KB := (Size + 1023) div 1024;
Inc (files_found);
Inc (KB_found, KB);
lblSize.Caption := IntToStr (KB_found) + ' KB';
ListBox1.Items.Add (Format ('%5d ', [KB]) + full_name);
end;
end;
until FindNext (s) <> 0;
FindClose (s);
end;
test_name := root + '*.*';
if FindFirst (test_name, faAnyFile, s) = 0 then
repeat
with s do
if ((Attr and faDirectory) <> 0) and ((Name <> '.') and (Name <> '..'))
then scan_tree (root + Name);
until FindNext (s) <> 0;
FindClose (s);
end;
procedure TForm1.Panel1Resize(Sender: TObject);
begin
btnFind.Top := Panel1.Height - 16 - btnFind.Height;
btnDelete.Top := btnFind.Top;
btnSelectAll.Top := btnFind.Top;
btnExit.Top := btnFind.Top;
ListBox1.Height := btnFind.Top - 16 - ListBox1.Top;
grpSeverity.Top := Panel1.Height - 8 - grpSeverity.Height;
btnNormal.Top := grpSeverity.Top + 16;
btnExtra.Top := grpSeverity.Top + 32;
DriveComboBox1.Top := grpSeverity.Top - 16 - DriveComboBox1.Height;
DirectoryListBox1.Height := DriveComboBox1.Top - 16 - DirectoryListBox1.Top;
end;
procedure TForm1.Panel2Resize(Sender: TObject);
begin
btnExit.Left := Panel2.Width - 16 - btnExit.Width;
ListBox1.Width := Panel2.Width - 16 - ListBox1